home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / sendun1a / wsksock.bas < prev   
Encoding:
BASIC Source File  |  1999-10-21  |  35.7 KB  |  928 lines
  1. Attribute VB_Name = "WSKSOCK"
  2. 'date stamp: sept 1, 1996 (for version control, please don't remove)
  3.  
  4. 'WINSOCK HEADER TAKEN FROM "ALT.WINSOCK.PROGRAMMING"
  5.  
  6. Option Explicit
  7.  
  8. Public Const FD_SETSIZE = 64
  9.  
  10. Type fd_set
  11.     fd_count As Integer
  12.     fd_array(FD_SETSIZE) As Integer
  13. End Type
  14.  
  15. Type timeval
  16.     tv_sec As Long
  17.     tv_usec As Long
  18. End Type
  19.  
  20. Type HostEnt
  21.     h_name As Long
  22.     h_aliases As Long
  23.     h_addrtype As Integer
  24.     h_length As Integer
  25.     h_addr_list As Long
  26. End Type
  27.  
  28. Public Const hostent_size = 16
  29.  
  30. Type servent
  31.     s_name As Long
  32.     s_aliases As Long
  33.     s_port As Integer
  34.     s_proto As Long
  35. End Type
  36.  
  37. Public Const servent_size = 14
  38.  
  39. Type protoent
  40.     p_name As Long
  41.     p_aliases As Long
  42.     p_proto As Integer
  43. End Type
  44. Public Const protoent_size = 10
  45.  
  46. Public Const IPPROTO_TCP = 6
  47. Public Const IPPROTO_UDP = 17
  48.  
  49. Public Const INADDR_NONE = &HFFFFFFFF
  50. Public Const INADDR_ANY = &H0
  51.  
  52. Type sockaddr
  53.     sin_family As Integer
  54.     sin_port As Integer
  55.     sin_addr As Long
  56.     sin_zero As String * 8
  57. End Type
  58.  
  59. Public Const sockaddr_size = 16
  60. Public saZero As sockaddr
  61.  
  62. Public Const WSA_DESCRIPTIONLEN = 256
  63. Public Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1
  64.  
  65. Public Const WSA_SYS_STATUS_LEN = 128
  66. Public Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1
  67.  
  68. Type WSADataType
  69.     wVersion As Integer
  70.     wHighVersion As Integer
  71.     szDescription As String * WSA_DescriptionSize
  72.     szSystemStatus As String * WSA_SysStatusSize
  73.     iMaxSockets As Integer
  74.     iMaxUdpDg As Integer
  75.     lpVendorInfo As Long
  76. End Type
  77.  
  78. Public Const INVALID_SOCKET = -1
  79. Public Const SOCKET_ERROR = -1
  80.  
  81. Public Const SOCK_STREAM = 1
  82. Public Const SOCK_DGRAM = 2
  83.  
  84. Public Const MAXGETHOSTSTRUCT = 1024
  85.  
  86. Public Const AF_INET = 2
  87. Public Const PF_INET = 2
  88.  
  89. Type LingerType
  90.     l_onoff As Integer
  91.     l_linger As Integer
  92. End Type
  93.  
  94. 'C errores
  95. Global Const WSAEINTR = 10004
  96. Global Const WSAEBADF = 10009
  97. Global Const WSAEACCES = 10013
  98. Global Const WSAEFAULT = 10014
  99. Global Const WSAEINVAL = 10022
  100. Global Const WSAEMFILE = 10024
  101.  
  102. 'errores Berkley
  103. Global Const WSAEWOULDBLOCK = 10035
  104. Global Const WSAEINPROGRESS = 10036
  105. Global Const WSAEALREADY = 10037
  106. Global Const WSAENOTSOCK = 10038
  107. Global Const WSAEDESTADDRREQ = 10039
  108. Global Const WSAEMSGSIZE = 10040
  109. Global Const WSAEPROTOTYPE = 10041
  110. Global Const WSAENOPROTOOPT = 10042
  111. Global Const WSAEPROTONOSUPPORT = 10043
  112. Global Const WSAESOCKTNOSUPPORT = 10044
  113. Global Const WSAEOPNOTSUPP = 10045
  114. Global Const WSAEPFNOSUPPORT = 10046
  115. Global Const WSAEAFNOSUPPORT = 10047
  116. Global Const WSAEADDRINUSE = 10048
  117. Global Const WSAEADDRNOTAVAIL = 10049
  118. Global Const WSAENETDOWN = 10050
  119. Global Const WSAENETUNREACH = 10051
  120. Global Const WSAENETRESET = 10052
  121. Global Const WSAECONNABORTED = 10053
  122. Global Const WSAECONNRESET = 10054
  123. Global Const WSAENOBUFS = 10055
  124. Global Const WSAEISCONN = 10056
  125. Global Const WSAENOTCONN = 10057
  126. Global Const WSAESHUTDOWN = 10058
  127. Global Const WSAETOOMANYREFS = 10059
  128. Global Const WSAETIMEDOUT = 10060
  129. Global Const WSAECONNREFUSED = 10061
  130. Global Const WSAELOOP = 10062
  131. Global Const WSAENAMETOOLONG = 10063
  132. Global Const WSAEHOSTDOWN = 10064
  133. Global Const WSAEHOSTUNREACH = 10065
  134. Global Const WSAENOTEMPTY = 10066
  135. Global Const WSAEPROCLIM = 10067
  136. Global Const WSAEUSERS = 10068
  137. Global Const WSAEDQUOT = 10069
  138. Global Const WSAESTALE = 10070
  139. Global Const WSAEREMOTE = 10071
  140.  
  141. 'errores extendidos
  142. Global Const WSASYSNOTREADY = 10091
  143. Global Const WSAVERNOTSUPPORTED = 10092
  144. Global Const WSANOTINITIALISED = 10093
  145. Global Const WSAHOST_NOT_FOUND = 11001
  146. Global Const WSATRY_AGAIN = 11002
  147. Global Const WSANO_RECOVERY = 11003
  148. Global Const WSANO_DATA = 11004
  149. Global Const WSANO_ADDRESS = 11004
  150.  
  151. '---ioctl Constants
  152. Public Const FIONREAD = &H8004667F
  153. Public Const FIONBIO = &H8004667E
  154. Public Const FIOASYNC = &H8004667D
  155.  
  156. #If Win16 Then
  157. '---Fucniones OS
  158.     Public Declare Function PostMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Integer
  159.     Public Declare Sub MemCopy Lib "Kernel" Alias "hmemcpy" (Dest As Any, Src As Any, ByVal cb&)
  160.     Public Declare Function lstrlen Lib "Kernel" (ByVal lpString As Any) As Integer
  161. '---ctes notificaci≤n async
  162.     Public Const SOL_SOCKET = &HFFFF
  163.     Public Const SO_LINGER = &H80
  164.     Public Const FD_READ = &H1
  165.     Public Const FD_WRITE = &H2
  166.     Public Const FD_OOB = &H4
  167.     Public Const FD_ACCEPT = &H8
  168.     Public Const FD_CONNECT = &H10
  169.     Public Const FD_CLOSE = &H20
  170. '---funciones de socket
  171.     Public Declare Function accept Lib "Winsock.dll" (ByVal s As Integer, addr As sockaddr, addrlen As Integer) As Integer
  172.     Public Declare Function bind Lib "Winsock.dll" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer
  173.     Public Declare Function closesocket Lib "Winsock.dll" (ByVal s As Integer) As Integer
  174.     Public Declare Function connect Lib "Winsock.dll" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer
  175.     Public Declare Function ioctlsocket Lib "Winsock.dll" (ByVal s As Integer, ByVal cmd As Long, argp As Long) As Integer
  176.     Public Declare Function getpeername Lib "Winsock.dll" (ByVal s As Integer, sName As sockaddr, namelen As Integer) As Integer
  177.     Public Declare Function getsockname Lib "Winsock.dll" (ByVal s As Integer, sName As sockaddr, namelen As Integer) As Integer
  178.     Public Declare Function getsockopt Lib "Winsock.dll" (ByVal s As Integer, ByVal level As Integer, ByVal optname As Integer, optval As Any, optlen As Integer) As Integer
  179.     Public Declare Function htonl Lib "Winsock.dll" (ByVal hostlong As Long) As Long
  180.     Public Declare Function htons Lib "Winsock.dll" (ByVal hostshort As Integer) As Integer
  181.     Public Declare Function inet_addr Lib "Winsock.dll" (ByVal cp As String) As Long
  182.     Public Declare Function inet_ntoa Lib "Winsock.dll" (ByVal inn As Long) As Long
  183.     Public Declare Function listen Lib "Winsock.dll" (ByVal s As Integer, ByVal backlog As Integer) As Integer
  184.     Public Declare Function ntohl Lib "Winsock.dll" (ByVal netlong As Long) As Long
  185.     Public Declare Function ntohs Lib "Winsock.dll" (ByVal netshort As Integer) As Integer
  186.     Public Declare Function recv Lib "Winsock.dll" (ByVal s As Integer, ByVal buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer
  187.     Public Declare Function recvfrom Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer, from As sockaddr, fromlen As Integer) As Integer
  188.     Public Declare Function ws_select Lib "Winsock.dll" Alias "select" (ByVal nfds As Integer, readfds As Any, writefds As Any, exceptfds As Any, timeout As timeval) As Integer
  189.     Public Declare Function send Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer
  190.     Public Declare Function sendto Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer, to_addr As sockaddr, ByVal tolen As Integer) As Integer
  191.     Public Declare Function setsockopt Lib "Winsock.dll" (ByVal s As Integer, ByVal level As Integer, ByVal optname As Integer, optval As Any, ByVal optlen As Integer) As Integer
  192.     Public Declare Function ShutDown Lib "Winsock.dll" Alias "shutdown" (ByVal s As Integer, ByVal how As Integer) As Integer
  193.     Public Declare Function socket Lib "Winsock.dll" (ByVal af As Integer, ByVal s_type As Integer, ByVal protocol As Integer) As Integer
  194. '---funciones de base de datos
  195.     Public Declare Function gethostbyaddr Lib "Winsock.dll" (addr As Long, ByVal addr_len As Integer, ByVal addr_type As Integer) As Long
  196.     Public Declare Function gethostbyname Lib "Winsock.dll" (ByVal host_name As String) As Long
  197.     Public Declare Function gethostname Lib "Winsock.dll" (ByVal host_name As String, ByVal namelen As Integer) As Integer
  198.     Public Declare Function getservbyport Lib "Winsock.dll" (ByVal Port As Integer, ByVal proto As String) As Long
  199.     Public Declare Function getservbyname Lib "Winsock.dll" (ByVal serv_name As String, ByVal proto As String) As Long
  200.     Public Declare Function getprotobynumber Lib "Winsock.dll" (ByVal proto As Integer) As Long
  201.     Public Declare Function getprotobyname Lib "Winsock.dll" (ByVal proto_name As String) As Long
  202. '---extensiones de OS
  203.     Public Declare Function WSAStartup Lib "Winsock.dll" (ByVal wVR As Integer, lpWSAD As WSADataType) As Integer
  204.     Public Declare Function WSACleanup Lib "Winsock.dll" () As Integer
  205.     Public Declare Sub WSASetLastError Lib "Winsock.dll" (ByVal iError As Integer)
  206.     Public Declare Function WSAGetLastError Lib "Winsock.dll" () As Integer
  207.     Public Declare Function WSAIsBlocking Lib "Winsock.dll" () As Integer
  208.     Public Declare Function WSAUnhookBlockingHook Lib "Winsock.dll" () As Integer
  209.     Public Declare Function WSASetBlockingHook Lib "Winsock.dll" (ByVal lpBlockFunc As Long) As Long
  210.     Public Declare Function WSACancelBlockingCall Lib "Winsock.dll" () As Integer
  211.     Public Declare Function WSAAsyncGetServByName Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal serv_name As String, ByVal proto As String, buf As Any, ByVal buflen As Integer) As Integer
  212.     Public Declare Function WSAAsyncGetServByPort Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal Port As Integer, ByVal proto As String, buf As Any, ByVal buflen As Integer) As Integer
  213.     Public Declare Function WSAAsyncGetProtoByName Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal proto_name As String, buf As Any, ByVal buflen As Integer) As Integer
  214.     Public Declare Function WSAAsyncGetProtoByNumber Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal number As Integer, buf As Any, ByVal buflen As Integer) As Integer
  215.     Public Declare Function WSAAsyncGetHostByName Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal host_name As String, buf As Any, ByVal buflen As Integer) As Integer
  216.     Public Declare Function WSAAsyncGetHostByAddr Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, addr As Long, ByVal addr_len As Integer, ByVal addr_type As Integer, buf As Any, ByVal buflen As Integer) As Integer
  217.     Public Declare Function WSACancelAsyncRequest Lib "Winsock.dll" (ByVal hAsyncTaskHandle As Integer) As Integer
  218.     Public Declare Function WSAAsyncSelect Lib "Winsock.dll" (ByVal s As Integer, ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal lEvent As Long) As Integer
  219.     Public Declare Function WSARecvEx Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer
  220. #ElseIf Win32 Then
  221. '---funciones de sistema
  222.     Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  223.     Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
  224.     Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
  225. '---ctes de notificacion async
  226.     Public Const SOL_SOCKET = &HFFFF&
  227.     Public Const SO_LINGER = &H80&
  228.     Public Const FD_READ = &H1&
  229.     Public Const FD_WRITE = &H2&
  230.     Public Const FD_OOB = &H4&
  231.     Public Const FD_ACCEPT = &H8&
  232.     Public Const FD_CONNECT = &H10&
  233.     Public Const FD_CLOSE = &H20&
  234. '---funciones de sockets
  235.     Public Declare Function accept Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, addrlen As Long) As Long
  236.     Public Declare Function bind Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
  237.     Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
  238.     Public Declare Function connect Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
  239.     Public Declare Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long
  240.     Public Declare Function getpeername Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long
  241.     Public Declare Function getsockname Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long
  242.     Public Declare Function getsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, optlen As Long) As Long
  243.     Public Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long
  244.     Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
  245.     Public Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
  246.     Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long
  247.     Public Declare Function listen Lib "wsock32.dll" (ByVal s As Long, ByVal backlog As Long) As Long
  248.     Public Declare Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long
  249.     Public Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer
  250.     Public Declare Function recv Lib "wsock32.dll" (ByVal s As Long, ByVal buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  251.     Public Declare Function recvfrom Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long, from As sockaddr, fromlen As Long) As Long
  252.     Public Declare Function ws_select Lib "wsock32.dll" Alias "select" (ByVal nfds As Long, readfds As fd_set, writefds As fd_set, exceptfds As fd_set, timeout As timeval) As Long
  253.     Public Declare Function send Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  254.     Public Declare Function sendto Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long, to_addr As sockaddr, ByVal tolen As Long) As Long
  255.     Public Declare Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, ByVal optlen As Long) As Long
  256.     Public Declare Function ShutDown Lib "wsock32.dll" Alias "shutdown" (ByVal s As Long, ByVal how As Long) As Long
  257.     Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
  258. '---funciones de base de datos
  259.     Public Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
  260.     Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
  261.     Public Declare Function gethostname Lib "wsock32.dll" (ByVal host_name As String, ByVal namelen As Long) As Long
  262.     Public Declare Function getservbyport Lib "wsock32.dll" (ByVal Port As Long, ByVal proto As String) As Long
  263.     Public Declare Function getservbyname Lib "wsock32.dll" (ByVal serv_name As String, ByVal proto As String) As Long
  264.     Public Declare Function getprotobynumber Lib "wsock32.dll" (ByVal proto As Long) As Long
  265.     Public Declare Function getprotobyname Lib "wsock32.dll" (ByVal proto_name As String) As Long
  266. '---extensiones OS
  267.     Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
  268.     Public Declare Function WSACleanup Lib "wsock32.dll" () As Long
  269.     Public Declare Sub WSASetLastError Lib "wsock32.dll" (ByVal iError As Long)
  270.     Public Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
  271.     Public Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
  272.     Public Declare Function WSAUnhookBlockingHook Lib "wsock32.dll" () As Long
  273.     Public Declare Function WSASetBlockingHook Lib "wsock32.dll" (ByVal lpBlockFunc As Long) As Long
  274.     Public Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long
  275.     Public Declare Function WSAAsyncGetServByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal serv_name As String, ByVal proto As String, buf As Any, ByVal buflen As Long) As Long
  276.     Public Declare Function WSAAsyncGetServByPort Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal Port As Long, ByVal proto As String, buf As Any, ByVal buflen As Long) As Long
  277.     Public Declare Function WSAAsyncGetProtoByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal proto_name As String, buf As Any, ByVal buflen As Long) As Long
  278.     Public Declare Function WSAAsyncGetProtoByNumber Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal number As Long, buf As Any, ByVal buflen As Long) As Long
  279.     Public Declare Function WSAAsyncGetHostByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal host_name As String, buf As Any, ByVal buflen As Long) As Long
  280.     Public Declare Function WSAAsyncGetHostByAddr Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, addr As Long, ByVal addr_len As Long, ByVal addr_type As Long, buf As Any, ByVal buflen As Long) As Long
  281.     Public Declare Function WSACancelAsyncRequest Lib "wsock32.dll" (ByVal hAsyncTaskHandle As Long) As Long
  282.     Public Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
  283.     Public Declare Function WSARecvEx Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  284. #End If
  285.  
  286. 'STUFF
  287. Public MySocket%
  288. Public SockReadBuffer$
  289. Public Const WSA_NoName = "Unknown"
  290. Public WSAStartedUp As Boolean  'FLAG
  291. Public Function WSAGetAsyncBufLen(ByVal lParam As Long) As Long
  292.     
  293.     If (lParam And &HFFFF&) > &H7FFF Then
  294.         WSAGetAsyncBufLen = (lParam And &HFFFF&) - &H10000
  295.     Else
  296.         WSAGetAsyncBufLen = lParam And &HFFFF&
  297.     End If
  298.     
  299. End Function
  300. Public Function WSAGetSelectEvent(ByVal lParam As Long) As Integer
  301.     
  302.     If (lParam And &HFFFF&) > &H7FFF Then
  303.         WSAGetSelectEvent = (lParam And &HFFFF&) - &H10000
  304.     Else
  305.         WSAGetSelectEvent = lParam And &HFFFF&
  306.     End If
  307.     
  308. End Function
  309. Public Function WSAGetAsyncError(ByVal lParam As Long) As Integer
  310.     
  311.     WSAGetAsyncError = (lParam And &HFFFF0000) \ &H10000
  312.     
  313. End Function
  314. Public Function AddrToIP(ByVal AddrOrIP$) As String
  315.     
  316.     AddrToIP$ = GetAscIP(GetHostByNameAlias(AddrOrIP$))
  317.     
  318. End Function
  319. 'debiese trabajar en 16/32
  320. #If Win16 Then
  321.     Function ConnectSock(ByVal Host$, ByVal Port%, retIpPort$, ByVal HWndToMsg%, ByVal Async%) As Integer
  322.     
  323.     Dim s%, SelectOps%, dummy%
  324.     
  325. #ElseIf Win32 Then
  326.     Function ConnectSock(ByVal Host$, ByVal Port&, retIpPort$, ByVal HWndToMsg&, ByVal Async%) As Long
  327.     
  328.     Dim s&, SelectOps&, dummy&
  329.     
  330. #End If
  331.     
  332.     Dim sockin As sockaddr
  333.     
  334.     SockReadBuffer$ = ""
  335.     sockin = saZero
  336.     sockin.sin_family = AF_INET
  337.     sockin.sin_port = htons(Port)
  338.     
  339.     If sockin.sin_port = INVALID_SOCKET Then
  340.         ConnectSock = INVALID_SOCKET
  341.         Exit Function
  342.     End If
  343.  
  344.     sockin.sin_addr = GetHostByNameAlias(Host$)
  345.     
  346.     If sockin.sin_addr = INADDR_NONE Then
  347.         ConnectSock = INVALID_SOCKET
  348.         Exit Function
  349.     End If
  350.     
  351.     retIpPort$ = GetAscIP$(sockin.sin_addr) & ":" & ntohs(sockin.sin_port)
  352.  
  353.     s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)
  354.     
  355.     If s < 0 Then
  356.         ConnectSock = INVALID_SOCKET
  357.         Exit Function
  358.     End If
  359.     
  360.     If SetSockLinger(s, 1, 0) = SOCKET_ERROR Then
  361.         If s > 0 Then
  362.             dummy = closesocket(s)
  363.         End If
  364.         ConnectSock = INVALID_SOCKET
  365.         Exit Function
  366.     End If
  367.     
  368.     If Not Async Then
  369.         If Not connect(s, sockin, sockaddr_size) = 0 Then
  370.             If s > 0 Then
  371.                 dummy = closesocket(s)
  372.             End If
  373.             ConnectSock = INVALID_SOCKET
  374.             Exit Function
  375.         End If
  376.         
  377.         If HWndToMsg <> 0 Then
  378.             
  379.             SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
  380.             
  381.             If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
  382.                 If s > 0 Then
  383.                     dummy = closesocket(s)
  384.                 End If
  385.                 
  386.                 ConnectSock = INVALID_SOCKET
  387.                 Exit Function
  388.             End If
  389.         End If
  390.     Else
  391.         SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
  392.         
  393.         If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
  394.             If s > 0 Then
  395.                 dummy = closesocket(s)
  396.             End If
  397.             
  398.             ConnectSock = INVALID_SOCKET
  399.             Exit Function
  400.         End If
  401.         
  402.         If connect(s, sockin, sockaddr_size) <> -1 Then
  403.             If s > 0 Then
  404.                 dummy = closesocket(s)
  405.             End If
  406.             ConnectSock = INVALID_SOCKET
  407.             Exit Function
  408.         End If
  409.     End If
  410.     
  411.     ConnectSock = s
  412.     
  413. End Function
  414. #If Win32 Then
  415.     Public Function SetSockLinger(ByVal SockNum&, ByVal OnOff%, ByVal LingerTime%) As Long
  416. #Else
  417.     Public Function SetSockLinger(ByVal SockNum%, ByVal OnOff%, ByVal LingerTime%) As Integer
  418. #End If
  419.     
  420.     Dim Linger As LingerType
  421.     
  422.     Linger.l_onoff = OnOff
  423.     Linger.l_linger = LingerTime
  424.     
  425.     If setsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then
  426.         Debug.Print "Error estableciendo informaci≤n de linger: " & WSAGetLastError()
  427.         SetSockLinger = SOCKET_ERROR
  428.     Else
  429.         If getsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then
  430.             Debug.Print "Error obteniendo informaci≤n de linger: " & WSAGetLastError()
  431.             SetSockLinger = SOCKET_ERROR
  432.         Else
  433.             Debug.Print "Linger esta ON si no es 0: "; Linger.l_onoff
  434.             Debug.Print "Linger tiempo si esta ON: "; Linger.l_linger
  435.         End If
  436.     End If
  437.     
  438. End Function
  439. Sub EndWinsock()
  440.     
  441.     Dim ret&
  442.     
  443.     If WSAIsBlocking() Then
  444.         ret = WSACancelBlockingCall()
  445.     End If
  446.     
  447.     ret = WSACleanup()
  448.     WSAStartedUp = False
  449.     
  450. End Sub
  451. Public Function GetAscIP(ByVal inn As Long) As String
  452.     
  453.     #If Win32 Then
  454.         Dim nStr&
  455.     #Else
  456.         Dim nStr%
  457.     #End If
  458.     
  459.     Dim lpStr&
  460.     Dim retString$
  461.     
  462.     retString = String(32, 0)
  463.     lpStr = inet_ntoa(inn)
  464.     
  465.     If lpStr Then
  466.         nStr = lstrlen(lpStr)
  467.         
  468.         If nStr > 32 Then nStr = 32
  469.         
  470.         MemCopy ByVal retString, ByVal lpStr, nStr
  471.         retString = left(retString, nStr)
  472.         GetAscIP = retString
  473.     Else
  474.         GetAscIP = "255.255.255.255"
  475.     End If
  476.     
  477. End Function
  478. Public Function GetHostByAddress(ByVal addr As Long) As String
  479.     
  480.     Dim phe&, ret&
  481.     Dim heDestHost As HostEnt
  482.     Dim HostName$
  483.     
  484.     phe = gethostbyaddr(addr, 4, PF_INET)
  485.     
  486.     If phe Then
  487.         MemCopy heDestHost, ByVal phe, hostent_size
  488.         HostName = String(256, 0)
  489.         MemCopy ByVal HostName, ByVal heDestHost.h_name, 256
  490.         GetHostByAddress = left(HostName, InStr(HostName, Chr(0)) - 1)
  491.     Else
  492.         GetHostByAddress = WSA_NoName
  493.     End If
  494.     
  495. End Function
  496. 'retorna IP como Long, en orden de bytes de red
  497. Public Function GetHostByNameAlias(ByVal HostName$) As Long
  498.     
  499.     Dim phe&
  500.     Dim heDestHost As HostEnt
  501.     Dim addrList&
  502.     Dim retIP&
  503.     
  504.     retIP = inet_addr(HostName$)
  505.     
  506.     If retIP = INADDR_NONE Then
  507.         phe = gethostbyname(HostName$)
  508.         If phe <> 0 Then
  509.             MemCopy heDestHost, ByVal phe, hostent_size
  510.             MemCopy addrList, ByVal heDestHost.h_addr_list, 4
  511.             MemCopy retIP, ByVal addrList, heDestHost.h_length
  512.         Else
  513.             retIP = INADDR_NONE
  514.         End If
  515.     End If
  516.     
  517.     GetHostByNameAlias = retIP
  518.     
  519. End Function
  520. 'retorna nombre de maquina local
  521. Public Function GetLocalHostName() As String
  522.     
  523.     Dim sName$
  524.     
  525.     sName = String(256, 0)
  526.     
  527.     If gethostname(sName, 256) Then
  528.         sName = WSA_NoName
  529.     Else
  530.         If InStr(sName, Chr(0)) Then
  531.             sName = left(sName, InStr(sName, Chr(0)) - 1)
  532.         End If
  533.     End If
  534.     
  535.     GetLocalHostName = sName
  536.     
  537. End Function
  538. #If Win16 Then
  539.     Public Function GetPeerAddress(ByVal s%) As String
  540.     Dim addrlen%
  541. #ElseIf Win32 Then
  542.     Public Function GetPeerAddress(ByVal s&) As String
  543.     Dim addrlen&
  544. #End If
  545.     
  546.     Dim sa As sockaddr
  547.     
  548.     addrlen = sockaddr_size
  549.     
  550.     If getpeername(s, sa, addrlen) Then
  551.         GetPeerAddress = ""
  552.     Else
  553.         GetPeerAddress = SockAddressToString(sa)
  554.     End If
  555.     
  556. End Function
  557. #If Win16 Then
  558.     Public Function GetPortFromString(ByVal PortStr$) As Integer
  559. #ElseIf Win32 Then
  560.     Public Function GetPortFromString(ByVal PortStr$) As Long
  561. #End If
  562.     
  563.     'convierte enteros de visual a enteros de c (unsigned int)
  564.     If Val(PortStr$) > 32767 Then
  565.         GetPortFromString = CInt(Val(PortStr$) - &H10000)
  566.     Else
  567.         GetPortFromString = Val(PortStr$)
  568.     End If
  569.     
  570.     If Err Then GetPortFromString = 0
  571.     
  572. End Function
  573. #If Win16 Then
  574.     Function GetProtocolByName(ByVal protocol$) As Integer
  575.     Dim tmpShort%
  576. #ElseIf Win32 Then
  577.     Function GetProtocolByName(ByVal protocol$) As Long
  578.     Dim tmpShort&
  579. #End If
  580.     
  581.     Dim ppe&
  582.     Dim peDestProt As protoent
  583.     
  584.     ppe = getprotobyname(protocol)
  585.     
  586.     If ppe Then
  587.         MemCopy peDestProt, ByVal ppe, protoent_size
  588.         GetProtocolByName = peDestProt.p_proto
  589.     Else
  590.         tmpShort = Val(protocol)
  591.         If tmpShort Then
  592.             GetProtocolByName = htons(tmpShort)
  593.         Else
  594.             GetProtocolByName = SOCKET_ERROR
  595.         End If
  596.     End If
  597.     
  598. End Function
  599. #If Win16 Then
  600.     Function GetServiceByName(ByVal service$, ByVal protocol$) As Integer
  601.     Dim serv%
  602. #ElseIf Win32 Then
  603.     Function GetServiceByName(ByVal service$, ByVal protocol$) As Long
  604.     Dim serv&
  605. #End If
  606.     Dim pse&
  607.     Dim seDestServ As servent
  608.     
  609.     pse = getservbyname(service, protocol)
  610.     
  611.     If pse Then
  612.         MemCopy seDestServ, ByVal pse, servent_size
  613.         GetServiceByName = seDestServ.s_port
  614.     Else
  615.         serv = Val(service)
  616.         If serv Then
  617.             GetServiceByName = htons(serv)
  618.         Else
  619.             GetServiceByName = INVALID_SOCKET
  620.         End If
  621.     End If
  622. End Function
  623. 'funcion en 16/32
  624. #If Win16 Then
  625.     Function GetSockAddress(ByVal s%) As String
  626.     Dim addrlen%
  627.     Dim ret%
  628. #ElseIf Win32 Then
  629.     Function GetSockAddress(ByVal s&) As String
  630.     Dim addrlen&
  631.     Dim ret&
  632. #End If
  633.     
  634.     Dim sa As sockaddr
  635.     Dim szRet$
  636.     
  637.     szRet = String(32, 0)
  638.     addrlen = sockaddr_size
  639.     
  640.     If getsockname(s, sa, addrlen) Then
  641.         GetSockAddress = ""
  642.     Else
  643.         GetSockAddress = SockAddressToString(sa)
  644.     End If
  645.     
  646. End Function
  647. 'debiese funcionar en 16/32
  648. Function GetWSAErrorString(ByVal errnum&) As String
  649.     On Error Resume Next
  650.     
  651.     Select Case errnum
  652.         Case 10004: GetWSAErrorString = "Llamada al sistema interrumpida."
  653.         Case 10009: GetWSAErrorString = "Mal n·mero de archivo."
  654.         Case 10013: GetWSAErrorString = "Permiso denegado."
  655.         Case 10014: GetWSAErrorString = "Mal direcci≤n."
  656.         Case 10022: GetWSAErrorString = "Argumanto Invßlido."
  657.         Case 10024: GetWSAErrorString = "Demasiados archivos abiertos."
  658.         Case 10035: GetWSAErrorString = "Operaci≤n deberφa bloquear."
  659.         Case 10036: GetWSAErrorString = "Operaci≤n en progreso."
  660.         Case 10037: GetWSAErrorString = "Operaci≤n ya estß en progreso."
  661.         Case 10038: GetWSAErrorString = "operaci≤n de socket o no sockets."
  662.         Case 10039: GetWSAErrorString = "Direcci≤n de destino requerida."
  663.         Case 10040: GetWSAErrorString = "Mensage demasiado grande."
  664.         Case 10041: GetWSAErrorString = "Tipo de protocolo err≤neo para el socket."
  665.         Case 10042: GetWSAErrorString = "Protocolo no disponible."
  666.         Case 10043: GetWSAErrorString = "Protocolo no soportado."
  667.         Case 10044: GetWSAErrorString = "Tipo de socket no soportado."
  668.         Case 10045: GetWSAErrorString = "Operaci≤n no soportada en el socket."
  669.         Case 10046: GetWSAErrorString = "Familia de Protocolo no soportada."
  670.         Case 10047: GetWSAErrorString = "Familia de Direcciones no soportada por Familia de Protocolo."
  671.         Case 10048: GetWSAErrorString = "Direcci≤n siempre en uso."
  672.         Case 10049: GetWSAErrorString = "No se puede asignar direcci≤n solicitada."
  673.         Case 10050: GetWSAErrorString = "La red estß abajo."
  674.         Case 10051: GetWSAErrorString = "Red inalcanzable."
  675.         Case 10052: GetWSAErrorString = "Red rechazo la conecci≤n."
  676.         Case 10053: GetWSAErrorString = "Software caus≤ aborto de la conecci≤n."
  677.         Case 10054: GetWSAErrorString = "Conexi≤n rechazada por peer."
  678.         Case 10055: GetWSAErrorString = "No existe espacio disponible en el buffer."
  679.         Case 10056: GetWSAErrorString = "Socket siempre conectado."
  680.         Case 10057: GetWSAErrorString = "Socket no estß conectado."
  681.         Case 10058: GetWSAErrorString = "No se puede enviar despuΘs de cierre del socket."
  682.         Case 10059: GetWSAErrorString = "Demasiadas referencias: no se puede empalmar."
  683.         Case 10060: GetWSAErrorString = "Tiempo de conexi≤n terminado."
  684.         Case 10061: GetWSAErrorString = "Conexi≤n rechazada."
  685.         Case 10062: GetWSAErrorString = "Demasiados niveles de links simb≤licos."
  686.         Case 10063: GetWSAErrorString = "Nombre de archivo demasiado largo."
  687.         Case 10064: GetWSAErrorString = "Host estß abajo."
  688.         Case 10065: GetWSAErrorString = "No existe router al host."
  689.         Case 10066: GetWSAErrorString = "Directorio no vacφo."
  690.         Case 10067: GetWSAErrorString = "Demasiados procesos."
  691.         Case 10068: GetWSAErrorString = "Demasiados usuarios."
  692.         Case 10069: GetWSAErrorString = "Cuota de disco excedida."
  693.         Case 10070: GetWSAErrorString = "Manipulador de archivo NFS da±ado."
  694.         Case 10071: GetWSAErrorString = "Demasiados niveles da±ados en ruta remota."
  695.         Case 10091: GetWSAErrorString = "Subsistema de red no utilizable."
  696.         Case 10092: GetWSAErrorString = "Winsock DLL no puede soportar Θsta aplicaci≤n."
  697.         Case 10093: GetWSAErrorString = "Winsock no inicializado."
  698.         Case 10101: GetWSAErrorString = "Desconectado."
  699.         Case 11001: GetWSAErrorString = "Host no encontrado."
  700.         Case 11002: GetWSAErrorString = "Host no autoritativo, no encontrado."
  701.         Case 11003: GetWSAErrorString = "Error no recuperable."
  702.         Case 11004: GetWSAErrorString = "Nombre vßlido, no existen registros del tipo requerido."
  703.         Case Else:
  704.     End Select
  705.     
  706. End Function
  707. 'funciona en 16/32
  708. Function IpToAddr(ByVal AddrOrIP$) As String
  709.     
  710.     On Error Resume Next
  711.     
  712.     IpToAddr = GetHostByAddress(GetHostByNameAlias(AddrOrIP$))
  713.     
  714.     If Err Then IpToAddr = WSA_NoName
  715.     
  716. End Function
  717. 'funciona en 16/32
  718. Function IrcGetAscIp(ByVal IPL$) As String
  719.     
  720.     'IRC especφfica, espera una IP grande guardada en orden de byte de red,'
  721.     'en una $ el tipo que deberφa ser analizado por una $ de comando DCC
  722.     On Error GoTo IrcGetAscIPError:
  723.     
  724.     Dim lpStr&
  725.     
  726. #If Win16 Then
  727.     Dim nStr%
  728. #ElseIf Win32 Then
  729.     Dim nStr&
  730. #End If
  731.     
  732.     Dim retString$
  733.     Dim inn&
  734.     
  735.     If Val(IPL) > 2147483647 Then
  736.         inn = Val(IPL) - 4294967296#
  737.     Else
  738.         inn = Val(IPL)
  739.     End If
  740.     
  741.     inn = ntohl(inn)
  742.     retString = String(32, 0)
  743.     lpStr = inet_ntoa(inn)
  744.     
  745.     If lpStr = 0 Then
  746.         IrcGetAscIp = "0.0.0.0"
  747.         Exit Function
  748.     End If
  749.     
  750.     nStr = lstrlen(lpStr)
  751.     
  752.     If nStr > 32 Then nStr = 32
  753.     
  754.     MemCopy ByVal retString, ByVal lpStr, nStr
  755.     
  756.     retString = left(retString, nStr)
  757.     
  758.     IrcGetAscIp = retString
  759.     
  760.     Exit Function
  761. IrcGetAscIPError:
  762.     IrcGetAscIp = "0.0.0.0"
  763.     Exit Function
  764.     Resume
  765. End Function
  766. 'trabaja en 16/32
  767. Function IrcGetLongIp(ByVal AscIp$) As String
  768.     'ASCII IP=>LONG IP en orden de bytes de red
  769.     'y puede ser usada en un comando DCC.
  770.     On Error GoTo IrcGetLongIpError:
  771.     
  772.     Dim inn&
  773.     
  774.     inn = inet_addr(AscIp)
  775.     inn = htonl(inn)
  776.     
  777.     If inn < 0 Then
  778.         IrcGetLongIp = CVar(inn + 4294967296#)
  779.         Exit Function
  780.     Else
  781.         IrcGetLongIp = CVar(inn)
  782.         Exit Function
  783.     End If
  784.     
  785.     Exit Function
  786.     
  787. IrcGetLongIpError:
  788.     IrcGetLongIp = "0"
  789.     Exit Function
  790.     Resume
  791. End Function
  792. 'deberφa trabajar en 16/32
  793. #If Win16 Then
  794. Public Function ListenForConnect(ByVal Port%, ByVal HWndToMsg%) As Integer
  795.     
  796.     Dim s%, dummy%
  797.     Dim SelectOps%
  798. #ElseIf Win32 Then
  799. Public Function ListenForConnect(ByVal Port&, ByVal HWndToMsg&) As Long
  800.     
  801.     Dim s&, dummy&
  802.     Dim SelectOps&
  803. #End If
  804.     
  805.     Dim sockin As sockaddr
  806.     
  807.     sockin = saZero     '0 fuera de la estructura
  808.     sockin.sin_family = AF_INET
  809.     sockin.sin_port = htons(Port)
  810.     
  811.     If sockin.sin_port = INVALID_SOCKET Then
  812.         ListenForConnect = INVALID_SOCKET
  813.         Exit Function
  814.     End If
  815.     
  816.     sockin.sin_addr = htonl(INADDR_ANY)
  817.     
  818.     If sockin.sin_addr = INADDR_NONE Then
  819.         ListenForConnect = INVALID_SOCKET
  820.         Exit Function
  821.     End If
  822.     
  823.     s = socket(PF_INET, SOCK_STREAM, 0)
  824.     
  825.     If s < 0 Then
  826.         ListenForConnect = INVALID_SOCKET
  827.         Exit Function
  828.     End If
  829.     
  830.     If bind(s, sockin, sockaddr_size) Then
  831.         If s > 0 Then
  832.             dummy = closesocket(s)
  833.         End If
  834.         
  835.         ListenForConnect = INVALID_SOCKET
  836.         Exit Function
  837.     End If
  838.     
  839.     SelectOps = FD_READ Or FD_WRITE Or FD_CLOSE Or FD_ACCEPT
  840.     
  841.     If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
  842.         If s > 0 Then
  843.             dummy = closesocket(s)
  844.         End If
  845.         
  846.         ListenForConnect = SOCKET_ERROR
  847.         Exit Function
  848.     End If
  849.     
  850.     If listen(s, 1) Then
  851.         If s > 0 Then
  852.             dummy = closesocket(s)
  853.         End If
  854.         ListenForConnect = INVALID_SOCKET
  855.         Exit Function
  856.     End If
  857.     
  858.     ListenForConnect = s
  859.     
  860. End Function
  861. 'debiese trabajar en 16/32
  862. #If Win16 Then
  863. Public Function SendData(ByVal s%, vMessage As Variant) As Integer
  864. #ElseIf Win32 Then
  865. Public Function SendData(ByVal s&, vMessage As Variant) As Long
  866. #End If
  867.     
  868.     Dim TheMsg() As Byte, sTemp$
  869.     TheMsg = ""
  870.     Select Case VarType(vMessage)
  871.         Case 8209   'arreglo de bytes
  872.             sTemp = vMessage
  873.             TheMsg = sTemp
  874.         Case 8      '$, si se recibe $,se asume que estamos en modo en lφnea (IRC)
  875.             #If Win32 Then
  876.                 sTemp = StrConv(vMessage, vbFromUnicode)
  877.             #Else
  878.                 sTemp = vMessage
  879.             #End If
  880.         Case Else
  881.             sTemp = CStr(vMessage)
  882.             #If Win32 Then
  883.                 sTemp = StrConv(vMessage, vbFromUnicode)
  884.             #Else
  885.                 sTemp = vMessage
  886.             #End If
  887.     End Select
  888.     
  889.     TheMsg = sTemp
  890.     
  891.     If UBound(TheMsg) > -1 Then
  892.         SendData = send(s, TheMsg(0), UBound(TheMsg) + 1, 0)
  893.     End If
  894.     
  895. End Function
  896. Public Function SockAddressToString(sa As sockaddr) As String
  897.     
  898.     SockAddressToString = GetAscIP(sa.sin_addr) & ":" & ntohs(sa.sin_port)
  899.     
  900. End Function
  901. Public Function StartWinsock(sDescription As String) As Boolean
  902.     
  903.     Dim StartupData As WSADataType
  904.     
  905.     If Not WSAStartedUp Then
  906.         If Not WSAStartup(&H101, StartupData) Then
  907.             WSAStartedUp = True
  908.             Debug.Print "wVersion="; StartupData.wVersion, "wHighVersion="; StartupData.wHighVersion
  909.             Debug.Print "If wVersion == 257 then everything is kewl"
  910.             Debug.Print "szDescription="; StartupData.szDescription
  911.             Debug.Print "szSystemStatus="; StartupData.szSystemStatus
  912.             Debug.Print "iMaxSockets="; StartupData.iMaxSockets, "iMaxUdpDg="; StartupData.iMaxUdpDg
  913.             sDescription = StartupData.szDescription
  914.         Else
  915.             WSAStartedUp = False
  916.         End If
  917.     End If
  918.     StartWinsock = WSAStartedUp
  919.     
  920. End Function
  921. Public Function WSAMakeSelectReply(TheEvent%, TheError%) As Long
  922.     
  923.     WSAMakeSelectReply = (TheError * &H10000) + (TheEvent And &HFFFF&)
  924.     
  925. End Function
  926.  
  927.  
  928.